Data Visualisation and Analysis

Download course materials from here.

bit.ly/Leeds_2019-02-28

install.packages(tidyverse,ordinal,lme4)

Base R functionality

Dataset sleep:

  • column 1 = how many extra hours of sleep were recorded
  • column 2 = which drug was administered
  • column 3 = which participant

Indices, or: finding the index of the value you want

What does this do?

sleep[1,]

How does this differ from [1,]?

How does this differ from [3,]?

sleep[,3] # what do you think this is?
 [1] 1  2  3  4  5  6  7  8  9  10 1  2  3  4  5  6  7 
[18] 8  9  10
Levels: 1 2 3 4 5 6 7 8 9 10

…which makes it dataset[row,column]

More descriptive methods

You can also navigate with column names:

sleep$ID
 [1] 1  2  3  4  5  6  7  8  9  10 1  2  3  4  5  6  7 
[18] 8  9  10
Levels: 1 2 3 4 5 6 7 8 9 10

How would you view the column extra?

sleep$extra
 [1]  0.7 -1.6 -0.2 -1.2 -0.1  3.4  3.7  0.8  0.0  2.0
[11]  1.9  0.8  1.1  0.1 -0.1  4.4  5.5  1.6  4.6  3.4

Use str() to get a summary of the structure of the dataset

str(sleep)
'data.frame':   20 obs. of  3 variables:
 $ extra: num  0.7 -1.6 -0.2 -1.2 -0.1 3.4 3.7 0.8 0 2 ...
 $ group: Factor w/ 2 levels "1","2": 1 1 1 1 1 1 1 1 1 1 ...
 $ ID   : Factor w/ 10 levels "1","2","3","4",..: 1 2 3 4 5 6 7 8 9 10 ...

What are all the unique values in ID?

unique(sleep$extra)
 [1]  0.7 -1.6 -0.2 -1.2 -0.1  3.4  3.7  0.8  0.0  2.0
[11]  1.9  1.1  0.1  4.4  5.5  1.6  4.6

What’s the value in the first row, third column?

sleep$ID[1]
[1] 1
Levels: 1 2 3 4 5 6 7 8 9 10

What’s the first element in the column ID?

You can also view the dataset as a spreadsheet (although it can’t be altered).

Tidyverse functionality

library(tidyverse)
── Attaching packages ────────────── tidyverse 1.2.1 ──
✔ ggplot2 3.1.0       ✔ purrr   0.3.0  
✔ tibble  2.0.1       ✔ dplyr   0.8.0.1
✔ tidyr   0.8.2       ✔ stringr 1.4.0  
✔ readr   1.3.1       ✔ forcats 0.4.0  
── Conflicts ───────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag()    masks stats::lag()

A tibble is different from a table.

Pipes are like toy funnels

%>%

How many attestations of each type of group?

How can you make a new column? Duplicate group into group2:

Let’s rename the levels in group to be “one” and “two”:

What’s wrong with this one?

sleep %>%
  mutate(group2 = case_when(group==1 ~ as.factor("one"),
                            group==2 ~ as.factor("two")))
invalid factor level, NA generated

Now, let’s recreate the count function with group_by and summarise:

We cal use group_by and summarise to do a lot more than just count:

Processing into tables

Dataset quakes:

What does quakes look like?

quakes %>%
  str
'data.frame':   1000 obs. of  5 variables:
 $ lat     : num  -20.4 -20.6 -26 -18 -20.4 ...
 $ long    : num  182 181 184 182 182 ...
 $ depth   : int  562 650 42 626 649 195 82 194 211 622 ...
 $ mag     : num  4.8 4.2 5.4 4.1 4 4 4.8 4.4 4.7 4.3 ...
 $ stations: int  41 15 43 19 11 12 43 15 35 19 ...

How many observations are there per “level” of magnitude?

Let’s create a table of the means, standard deviations, and standard errors for both stations reporting and depths:

This dataset is wide. Let’s make it long using gather (compare to spread):

quakes %>%
  group_by(mag) %>%
  summarise(n = n(),
            stationMean = mean(stations),
            stationSD = sd(stations),
            stationSE = sd(stations)/sqrt(n),
            depthMean = mean(depth),
            depthSD = sd(depth),
            depthSE = sd(depth)/sqrt(n)) %>%
  gather(measurement, values, 3:8) #-> quakesLong

Basic ggplot2

install.packages("ggbeeswarm")
Error in install.packages : Updating loaded packages

Dataset iris:

The function ggplot layers different geometries and aesthetics to build up a plot:

In what ways might we change this plot?

Going back to quakes, let’s pipe our table into a ggplot (and fill in missing values):

quakes %>%
  group_by(mag) %>%
  summarise(n=n(),
            sta=mean(stations),
            staSD=sd(stations),
            staSE=staSD/sqrt(n),
            dep=mean(depth),
            depSD=sd(depth),
            depSE=depSD/sqrt(n)) %>%
  ggplot(aes(x=mag)) +
  geom_point(aes(y=sta),colour="red")+
  geom_path(aes(y=sta),colour="red")+
  geom_ribbon(aes(ymin=sta-staSD,ymax=sta+staSD),width=.05,fill="red",alpha=.2) +
  geom_ribbon(aes(ymin=sta-staSE,ymax=sta+staSE),width=.05,fill="red",alpha=.5) +
  geom_point(aes(y=dep),colour="blue")+
  geom_path(aes(y=dep),colour="blue")+
  geom_ribbon(aes(ymin=dep-depSD,ymax=dep+depSD),width=.05,fill="blue",alpha=.2) +
  geom_ribbon(aes(ymin=dep-depSE,ymax=dep+depSE),width=.05,fill="blue",alpha=.5) +
  theme_bw() + ylab("depth OR number of stations reporting")
Ignoring unknown parameters: widthIgnoring unknown parameters: widthIgnoring unknown parameters: widthIgnoring unknown parameters: width

Inheritance:

Storytelling with data

See Simulated Data notebook

data <- read_csv("../data/simulated-data.csv")
Parsed with column specification:
cols(
  subj = col_double(),
  age = col_double(),
  item = col_double(),
  freq = col_character(),
  gram = col_character(),
  rating = col_double(),
  accuracy = col_double(),
  region = col_double(),
  word = col_character(),
  rt = col_double()
)

The Ten Commandments of Statistical Inference

Exploration

Plot boxplots and violin plots for the ratings. Subset by participant.

Group by region, word, frequency, and grammaticality. Summarise mean and standard error.

Why?

Well, check out the Datasaurus Dozen, which all have the same x/y means and standard deviations:

Continuous data

library(lme4)
Loading required package: Matrix

Attaching package: ‘Matrix’

The following object is masked from ‘package:tidyr’:

    expand

Build a simple linear model to examine region 3 (the verb):

# summary(
#     lm ( DV ~ IV1 * IV2 + IV3 , data = data )
#        )
summary(lm(rt ~ freq * gram + age, data[data$region==3,]))

Call:
lm(formula = rt ~ freq * gram + age, data = data[data$region == 
    3, ])

Residuals:
     Min       1Q   Median       3Q      Max 
-266.663  -56.801    3.386   52.437  271.658 

Coefficients:
                Estimate Std. Error t value Pr(>|t|)    
(Intercept)     321.2832    12.1092  26.532  < 2e-16 ***
freqlow          31.2062     8.0033   3.899 0.000105 ***
gramyes          -1.9600     8.0033  -0.245 0.806600    
age               1.2848     0.2503   5.134 3.58e-07 ***
freqlow:gramyes   1.5559    11.3184   0.137 0.890697    
---
Signif. codes:  
0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 80.03 on 795 degrees of freedom
Multiple R-squared:  0.06839,   Adjusted R-squared:  0.0637 
F-statistic: 14.59 on 4 and 795 DF,  p-value: 1.663e-11

Add in mixed effects for a linear mixed effects model:

#summary(
#  lmer( DV ~ IV1 * IV2 + IV3 + ( 1 | RV1 ) + ( 1 | RV2 ) , data = data)
#        )
summary(lmer(rt ~ freq+gram+freq:gram+age + (1|subj) + (1|item),data %>% filter(region==3)))
Linear mixed model fit by REML ['lmerMod']
Formula: 
rt ~ freq + gram + freq:gram + age + (1 | subj) + (1 | item)
   Data: data %>% filter(region == 3)

REML criterion at convergence: 9254.5

Scaled residuals: 
    Min      1Q  Median      3Q     Max 
-3.1961 -0.7094  0.0332  0.6754  3.3830 

Random effects:
 Groups   Name        Variance Std.Dev.
 subj     (Intercept)  129.944 11.399  
 item     (Intercept)    8.753  2.958  
 Residual             6273.993 79.209  
Number of obs: 800, groups:  subj, 40; item, 20

Fixed effects:
                Estimate Std. Error t value
(Intercept)     321.2832    13.9689  23.000
freqlow          31.2062     8.1389   3.834
gramyes          -1.9600     8.1389  -0.241
age               1.2848     0.2946   4.362
freqlow:gramyes   1.5559    11.5101   0.135

Correlation of Fixed Effects:
            (Intr) freqlw gramys age   
freqlow     -0.291                     
gramyes     -0.291  0.500              
age         -0.902  0.000  0.000       
frqlw:grmys  0.206 -0.707 -0.707  0.000

Bodo Winter telling it like it is. (Photo credit: Adam Schembri 27/02/2019)

We should do model comparison to assess the contribution of each of the factors to the overall fit. But, read the Bates et al and Barr et al papers for an overview of the debates around how to design and test models.

Let’s do model comparison for region 3:

anova(mdl1.int,mdl1.grm) # int vs grm
refitting model(s) with ML (instead of REML)
Data: data[data$region == 3, ]
Models:
mdl1.grm: rt ~ freq + age + accuracy + (1 | subj)
mdl1.int: rt ~ freq + gram + age + accuracy + (1 | subj)
         Df    AIC    BIC  logLik deviance  Chisq Chi Df
mdl1.grm  6 9287.4 9315.5 -4637.7   9275.4              
mdl1.int  7 9289.4 9322.1 -4637.7   9275.4 0.0451      1
         Pr(>Chisq)
mdl1.grm           
mdl1.int     0.8318

How do regions 4 and 5 compare?:

Ordinal data

First, how could we go about using lmer for rating data?

mdl.ord <- lmer(rating ~ freq*gram + (1|subj), data%>%filter(region==1))
summary(mdl.ord)
Linear mixed model fit by REML ['lmerMod']
Formula: rating ~ freq * gram + (1 | subj)
   Data: data %>% filter(region == 1)

REML criterion at convergence: 2376.8

Scaled residuals: 
     Min       1Q   Median       3Q      Max 
-3.04800 -0.83352 -0.04503  0.75865  2.94849 

Random effects:
 Groups   Name        Variance Std.Dev.
 subj     (Intercept) 0.01176  0.1085  
 Residual             1.11860  1.0576  
Number of obs: 800, groups:  subj, 40

Fixed effects:
                Estimate Std. Error t value
(Intercept)      2.39500    0.07673  31.215
freqlow         -0.47000    0.10576  -4.444
gramyes          1.82000    0.10576  17.208
freqlow:gramyes  0.32000    0.14957   2.139

Correlation of Fixed Effects:
            (Intr) freqlw gramys
freqlow     -0.689              
gramyes     -0.689  0.500       
frqlw:grmys  0.487 -0.707 -0.707

Better ordinal data

library(ordinal)

Attaching package: ‘ordinal’

The following objects are masked from ‘package:lme4’:

    ranef, VarCorr

The following object is masked from ‘package:dplyr’:

    slice

For the ratings, build models like above, but using clmm() (these take a little longer to run):

mdl.ord.clmm <- clmm(as.factor(rating) ~ freq*gram + age + (1|subj), data%>%filter(region==1))
summary(mdl.ord.clmm)
Cumulative Link Mixed Model fitted with the Laplace approximation

formula: as.factor(rating) ~ freq * gram + age + (1 | subj)
data:    data %>% filter(region == 1)

Random effects:
 Groups Name        Variance Std.Dev.
 subj   (Intercept) 0.02675  0.1636  
Number of groups:  subj 40 

Coefficients:
                 Estimate Std. Error z value Pr(>|z|)    
freqlow         -0.928986   0.186594  -4.979  6.4e-07 ***
gramyes          2.846015   0.207608  13.709  < 2e-16 ***
age             -0.007218   0.006135  -1.177   0.2394    
freqlow:gramyes  0.674074   0.264725   2.546   0.0109 *  
---
Signif. codes:  
0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Threshold coefficients:
    Estimate Std. Error z value
1|2 -1.35904    0.30108  -4.514
2|3 -0.06295    0.29158  -0.216
3|4  1.14857    0.29870   3.845
4|5  2.52700    0.31329   8.066

See visualising_ordinal_data.R for Predicted Curves script

Binomial data

data %>%
  filter(region==1) %>%
  mutate(age_group = case_when(age<35~"young",
                               age>=35&age<=55~"middle",
                               age>55~"old")) %>%
  mutate(age_group = factor(age_group,levels=c("young","middle","old")))%>%
  group_by(freq,gram,age_group) %>%
  summarise(accuracy=sum(accuracy)/n()) %>%
  ggplot(aes(x=freq,fill=gram,y=accuracy))+
  geom_bar(stat="identity",position="dodge")+
  facet_wrap(~age_group)

Does accuracy change as a function of age?

# summary(
#   glmer( DV ~ IV1 * IV2 + IV3 + ( 1 | RV1 ) + ( 1 | RV2 ), family="binomial", data = data)
# )

Do model comparison to assess the contribution of each of the factors to the overall fit:

LS0tCnRpdGxlOiAiKipXb3Jrc2hvcCoqIgphdXRob3I6ICJEciBMYXVyZW4gTSBBY2tlcm1hbiIKZGF0ZTogIjI4IEZFQiAyMDE5IgpvdXRwdXQ6CiAgaHRtbF9ub3RlYm9vazoKICAgIHRvYzogZmFsc2UKICAgIHRoZW1lOiB5ZXRpCiAgICBoaWdobGlnaHQ6IGRlZmF1bHQKICAgIG51bWJlcl9zZWN0aW9uczogZmFsc2UKLS0tCmBgYHtyIHNldHVwLCBpbmNsdWRlPUZBTFNFfQprbml0cjo6b3B0c19jaHVuayRzZXQoZWNobyA9IFRSVUUpCmBgYAoKIyBEYXRhIFZpc3VhbGlzYXRpb24gYW5kIEFuYWx5c2lzICB7LnRhYnNldH0KCkRvd25sb2FkIGNvdXJzZSBtYXRlcmlhbHMgZnJvbSBbaGVyZV0oaHR0cHM6Ly9naXRodWIuY29tL1ZlcmJpbmdOb3Vucy9ub3RlYm9va3MvYmxvYi9tYXN0ZXIvMjAxOTAyMjhfV29ya3Nob3AuemlwKS4KCiBiaXQubHkvTGVlZHNfMjAxOS0wMi0yOAoKYGBge3J9Cmluc3RhbGwucGFja2FnZXModGlkeXZlcnNlLG9yZGluYWwsbG1lNCkKYGBgCgoKIyMgQmFzZSBSIGZ1bmN0aW9uYWxpdHkgey50YWJzZXR9Cgo+IERhdGFzZXQgYHNsZWVwYDoKCmBgYHtyfQpoZWFkKHNsZWVwKQpgYGAKCiogY29sdW1uIDEgPSBob3cgbWFueSBleHRyYSBob3VycyBvZiBzbGVlcCB3ZXJlIHJlY29yZGVkCiogY29sdW1uIDIgPSB3aGljaCBkcnVnIHdhcyBhZG1pbmlzdGVyZWQKKiBjb2x1bW4gMyA9IHdoaWNoIHBhcnRpY2lwYW50CgojIyMgSW5kaWNlcywgb3I6IGZpbmRpbmcgdGhlIGluZGV4IG9mIHRoZSB2YWx1ZSB5b3Ugd2FudAoKV2hhdCBkb2VzIHRoaXMgZG8/CmBgYHtyfQpzbGVlcFsxLF0KYGBgCgpIb3cgZG9lcyB0aGlzIGRpZmZlciBmcm9tIGBbMSxdYD8KYGBge3J9CnNsZWVwWzIsXSAjIHNvIHRoYXQgbWVhbnMgdGhpcyBpcyByb3cgMgpgYGAKCkhvdyBkb2VzIHRoaXMgZGlmZmVyIGZyb20gYFszLF1gPwpgYGB7cn0Kc2xlZXBbLDNdICMgd2hhdCBkbyB5b3UgdGhpbmsgdGhpcyBpcz8KYGBgCgrigKZ3aGljaCBtYWtlcyBpdCBgZGF0YXNldFtyb3csY29sdW1uXWAKCiMjIyBNb3JlIGRlc2NyaXB0aXZlIG1ldGhvZHMKCllvdSBjYW4gYWxzbyBuYXZpZ2F0ZSB3aXRoIGNvbHVtbiBuYW1lczoKYGBge3J9CnNsZWVwJElECmBgYAoKSG93IHdvdWxkIHlvdSB2aWV3IHRoZSBjb2x1bW4gYGV4dHJhYD8KYGBge3J9CnNsZWVwJGV4dHJhCmBgYAoKVXNlIGBzdHIoKWAgdG8gZ2V0IGEgc3VtbWFyeSBvZiB0aGUgc3RydWN0dXJlIG9mIHRoZSBkYXRhc2V0CmBgYHtyfQpzdHIoc2xlZXApCmBgYAoKV2hhdCBhcmUgYWxsIHRoZSB1bmlxdWUgdmFsdWVzIGluIGBJRGA/CmBgYHtyfQp1bmlxdWUoc2xlZXAkZXh0cmEpCmBgYAoKV2hhdCdzIHRoZSB2YWx1ZSBpbiB0aGUgZmlyc3Qgcm93LCB0aGlyZCBjb2x1bW4/CmBgYHtyfQpzbGVlcFsxLDNdCnNsZWVwWzEsXSRJRApzbGVlcCRJRFsxXQpgYGAKCldoYXQncyB0aGUgZmlyc3QgZWxlbWVudCBpbiB0aGUgY29sdW1uIGBJRGA/CmBgYHtyfQoKYGBgCgpZb3UgY2FuIGFsc28gdmlldyB0aGUgZGF0YXNldCBhcyBhIHNwcmVhZHNoZWV0IChhbHRob3VnaCBpdCBjYW4ndCBiZSBhbHRlcmVkKS4KYGBge3J9ClZpZXcoc2xlZXApCmBgYAoKIyMgVGlkeXZlcnNlIGZ1bmN0aW9uYWxpdHkgey50YWJzZXR9CgpgYGB7cn0KbGlicmFyeSh0aWR5dmVyc2UpCmBgYAoKQSBgdGliYmxlYCBpcyBkaWZmZXJlbnQgZnJvbSBhIGB0YWJsZWAuCmBgYHtyfQphcy50aWJibGUoc2xlZXApCmBgYAoKPiBQaXBlcyBhcmUgbGlrZSB0b3kgZnVubmVscwoKJT4lCgohW10oLi4vaW1hZ2VzL3BpcGVzLmpwZykKCgpgYGB7cn0Kc2xlZXAgJT4lCiAgaGVhZCgpCgojIG9yCgpzbGVlcCAlPiUKICBoZWFkCmBgYAoKSG93IG1hbnkgYXR0ZXN0YXRpb25zIG9mIGVhY2ggdHlwZSBvZiBgZ3JvdXBgPwpgYGB7cn0Kc2xlZXAgJT4lCiAgY291bnQoZ3JvdXApCmBgYAoKSG93IGNhbiB5b3UgbWFrZSBhIG5ldyBjb2x1bW4/IER1cGxpY2F0ZSBgZ3JvdXBgIGludG8gYGdyb3VwMmA6CmBgYHtyfQpzbGVlcCAlPiUKICBtdXRhdGUoZ3JvdXAyID0gZ3JvdXApCmBgYAoKTGV0J3MgcmVuYW1lIHRoZSBsZXZlbHMgaW4gYGdyb3VwYCB0byBiZSAib25lIiBhbmQgInR3byI6CmBgYHtyfQpzbGVlcCAlPiUKICBtdXRhdGUoZ3JvdXAyID0gY2FzZV93aGVuKGdyb3VwPT0xIH4gIm9uZSIsCiAgICAgICAgICAgICAgICAgICAgICAgICAgICBUUlVFIH4gInR3byIpKQpgYGAKCgpXaGF0J3Mgd3Jvbmcgd2l0aCB0aGlzIG9uZT8KYGBge3J9CnNsZWVwICU+JQogIG11dGF0ZShncm91cDIgPSBjYXNlX3doZW4oZ3JvdXA9PTEgfiBhcy5mYWN0b3IoIm9uZSIpLAogICAgICAgICAgICAgICAgICAgICAgICAgICAgZ3JvdXA9PTIgfiBhcy5mYWN0b3IoInR3byIpKSkKYGBgCgoKYGBge3J9CnNsZWVwICU+JQogIG11dGF0ZShncm91cDIgPSBjYXNlX3doZW4oZ3JvdXA9PTEgfiJvbmUiLAogICAgICAgICAgICAgICAgICAgICAgICAgICAgZ3JvdXA9PTIgfiJ0d28iKSkgJT4lCiAgbXV0YXRlKGdyb3VwMiA9IGFzLmZhY3Rvcihncm91cDIpKQpgYGAKCgpOb3csIGxldCdzIHJlY3JlYXRlIHRoZSBgY291bnRgIGZ1bmN0aW9uIHdpdGggYGdyb3VwX2J5YCBhbmQgYHN1bW1hcmlzZWA6CmBgYHtyfQpzbGVlcCAlPiUKICBncm91cF9ieShncm91cCkgJT4lCiAgc3VtbWFyaXNlKG4gPSBuKCkpCmBgYAoKCldlIGNhbCB1c2UgYGdyb3VwX2J5YCBhbmQgYHN1bW1hcmlzZWAgdG8gZG8gYSBsb3QgbW9yZSB0aGFuIGp1c3QgY291bnQ6CmBgYHtyfQojIG1lYW4gdmFsdWUgb2YgYGV4dHJhYCBieSBgZ3JvdXAyYApzbGVlcCAlPiUKICAjbXV0YXRlKGdyb3VwMiA9IGNhc2Vfd2hlbihncm91cD09MSB+Im9uZSIsCiAgIyAgICAgICAgICAgICAgICAgICAgICAgICAgZ3JvdXA9PTIgfiJ0d28iKSkgJT4lCiAgI211dGF0ZShncm91cDIgPSBhcy5mYWN0b3IoZ3JvdXAyKSkgJT4lCiAgZ3JvdXBfYnkoZ3JvdXApICU+JQogIHN1bW1hcmlzZShlZmZlY3RNZWFuID0gbWVhbihleHRyYSkpCmBgYAoKCiMjIFByb2Nlc3NpbmcgaW50byB0YWJsZXMKCj4gRGF0YXNldCBgcXVha2VzYDoKCldoYXQgZG9lcyBgcXVha2VzYCBsb29rIGxpa2U/CmBgYHtyfQpxdWFrZXMgJT4lCiAgc3RyCgpWaWV3KHF1YWtlcykKYGBgCgpIb3cgbWFueSBvYnNlcnZhdGlvbnMgYXJlIHRoZXJlIHBlciAibGV2ZWwiIG9mIG1hZ25pdHVkZT8KYGBge3J9CnVuaXF1ZShxdWFrZXMkbWFnKQoKcXVha2VzICU+JQogIGdyb3VwX2J5KG1hZykgJT4lCiAgc3VtbWFyaXNlKG51bWJlck9mT2J2cyA9IG4oKSkKYGBgCgpMZXQncyBjcmVhdGUgYSB0YWJsZSBvZiB0aGUgbWVhbnMsIHN0YW5kYXJkIGRldmlhdGlvbnMsIGFuZCBzdGFuZGFyZCBlcnJvcnMgZm9yIGJvdGggc3RhdGlvbnMgcmVwb3J0aW5nIGFuZCBkZXB0aHM6CmBgYHtyfQpxdWFrZXMgJT4lCiAgZ3JvdXBfYnkobWFnKSAlPiUKICBzdW1tYXJpc2UobiA9IG4oKSwKICAgICAgICAgICAgc3RhdGlvbk1lYW4gPSBtZWFuKHN0YXRpb25zKSwKICAgICAgICAgICAgc3RhdGlvblNEID0gc2Qoc3RhdGlvbnMpLAogICAgICAgICAgICBzdGF0aW9uU0UgPSBzZChzdGF0aW9ucykvc3FydChuKSwKICAgICAgICAgICAgZGVwdGhNZWFuID0gbWVhbihkZXB0aCksCiAgICAgICAgICAgIGRlcHRoU0QgPSBzZChkZXB0aCksCiAgICAgICAgICAgIGRlcHRoU0UgPSBzZChkZXB0aCkvc3FydChuKSkKYGBgCgpUaGlzIGRhdGFzZXQgaXMgd2lkZS4gTGV0J3MgbWFrZSBpdCBsb25nIHVzaW5nIGBnYXRoZXJgIChjb21wYXJlIHRvIGBzcHJlYWRgKToKYGBge3J9CnF1YWtlcyAlPiUKICBncm91cF9ieShtYWcpICU+JQogIHN1bW1hcmlzZShuID0gbigpLAogICAgICAgICAgICBzdGF0aW9uTWVhbiA9IG1lYW4oc3RhdGlvbnMpLAogICAgICAgICAgICBzdGF0aW9uU0QgPSBzZChzdGF0aW9ucyksCiAgICAgICAgICAgIHN0YXRpb25TRSA9IHNkKHN0YXRpb25zKS9zcXJ0KG4pLAogICAgICAgICAgICBkZXB0aE1lYW4gPSBtZWFuKGRlcHRoKSwKICAgICAgICAgICAgZGVwdGhTRCA9IHNkKGRlcHRoKSwKICAgICAgICAgICAgZGVwdGhTRSA9IHNkKGRlcHRoKS9zcXJ0KG4pKSAlPiUKICBnYXRoZXIobWVhc3VyZW1lbnQsIHZhbHVlcywgMzo4KSAjLT4gcXVha2VzTG9uZwpgYGAKCgojIyBCYXNpYyBnZ3Bsb3QyIHsudGFic2V0IC50YWJzZXQtcGlsbHN9CgpgYGB7cn0KIyBodHRwczovL2Jvb2tkb3duLm9yZy9uZHBoaWxsaXBzL1lhUnJyL3BpcmF0ZXBsb3QuaHRtbApsaWJyYXJ5KHRpZHl2ZXJzZSkKaW5zdGFsbC5wYWNrYWdlcygiZ2diZWVzd2FybSIpCmxpYnJhcnkoZ2diZWVzd2FybSkKYGBgCgo+IERhdGFzZXQgYGlyaXNgOgoKVGhlIGZ1bmN0aW9uIGBnZ3Bsb3RgIGxheWVycyBkaWZmZXJlbnQgZ2VvbWV0cmllcyBhbmQgYWVzdGhldGljcyB0byBidWlsZCB1cCBhIHBsb3Q6CmBgYHtyfQppcmlzICU+JQogIG11dGF0ZShTZXBhbC5XaWR0aCA9IFNlcGFsLldpZHRoK3Jub3JtKGxlbmd0aChTZXBhbC5XaWR0aCksMCwuMSkpJT4lCiAgZ2dwbG90KGFlcyh4PVNwZWNpZXMseT1TZXBhbC5XaWR0aCxmaWxsPVNwZWNpZXMpKSArCiAgZ2VvbV92aW9saW4obHR5PTAsYWxwaGE9LjUpKwogIGdlb21fYm94cGxvdChhbHBoYT0wLjUsbHdkPS41KSArCiAgZ2VvbV9xdWFzaXJhbmRvbShkb2RnZS53aWR0aD0xLCBhbHBoYT0uNSkKYGBgCgpJbiB3aGF0IHdheXMgbWlnaHQgd2UgY2hhbmdlIHRoaXMgcGxvdD8KYGBge3J9CmlyaXMgJT4lCiAgbXV0YXRlKAogICAgU2VwYWwuV2lkdGggPSBTZXBhbC5XaWR0aCArIAogICAgICBybm9ybSgKICAgICAgICBsZW5ndGgoU2VwYWwuV2lkdGgpICwgMCAsIC4xCiAgICAgICAgKQogICAgKSAlPiUKICBnZ3Bsb3QoYWVzKHg9U3BlY2llcyx5PVNlcGFsLldpZHRoKSkgKwogIGdlb21fYm94cGxvdCgpICsKICBnZW9tX3F1YXNpcmFuZG9tKGFlcyhwY2g9U3BlY2llcyksIGFscGhhPS41KQogICNnZ3Bsb3QoYWVzKHg9U3BlY2llcyx5PVNlcGFsLldpZHRoLGZpbGw9U3BlY2llcykpICsKICAjZ2VvbV92aW9saW4obHR5PTAsYWxwaGE9LjUpKwogICNnZW9tX2JveHBsb3QoYWxwaGE9MC41LGx3ZD0uNSkgKwogICNnZW9tX3F1YXNpcmFuZG9tKGRvZGdlLndpZHRoPTEsIGFscGhhPS41KQpgYGAKCgpHb2luZyBiYWNrIHRvIGBxdWFrZXNgLCBsZXQncyBwaXBlIG91ciB0YWJsZSBpbnRvIGEgZ2dwbG90IChhbmQgZmlsbCBpbiBtaXNzaW5nIHZhbHVlcyk6CmBgYHtyfQpxdWFrZXMgJT4lCiAgZ3JvdXBfYnkobWFnKSAlPiUKICBzdW1tYXJpc2Uobj1uKCksCiAgICAgICAgICAgIHN0YT1tZWFuKHN0YXRpb25zKSwKICAgICAgICAgICAgc3RhU0Q9c2Qoc3RhdGlvbnMpLAogICAgICAgICAgICBzdGFTRT1zdGFTRC9zcXJ0KG4pLAogICAgICAgICAgICBkZXA9bWVhbihkZXB0aCksCiAgICAgICAgICAgIGRlcFNEPXNkKGRlcHRoKSwKICAgICAgICAgICAgZGVwU0U9ZGVwU0Qvc3FydChuKSkgJT4lCiAgZ2dwbG90KGFlcyh4PW1hZykpICsKICBnZW9tX3BvaW50KGFlcyh5PXN0YSksY29sb3VyPSJyZWQiKSsKICBnZW9tX3BhdGgoYWVzKHk9c3RhKSxjb2xvdXI9InJlZCIpKwogIGdlb21fcmliYm9uKGFlcyh5bWluPXN0YS1zdGFTRCx5bWF4PXN0YStzdGFTRCksd2lkdGg9LjA1LGZpbGw9InJlZCIsYWxwaGE9LjIpICsKICBnZW9tX3JpYmJvbihhZXMoeW1pbj1zdGEtc3RhU0UseW1heD1zdGErc3RhU0UpLHdpZHRoPS4wNSxmaWxsPSJyZWQiLGFscGhhPS41KSArCiAgZ2VvbV9wb2ludChhZXMoeT1kZXApLGNvbG91cj0iYmx1ZSIpKwogIGdlb21fcGF0aChhZXMoeT1kZXApLGNvbG91cj0iYmx1ZSIpKwogIGdlb21fcmliYm9uKGFlcyh5bWluPWRlcC1kZXBTRCx5bWF4PWRlcCtkZXBTRCksd2lkdGg9LjA1LGZpbGw9ImJsdWUiLGFscGhhPS4yKSArCiAgZ2VvbV9yaWJib24oYWVzKHltaW49ZGVwLWRlcFNFLHltYXg9ZGVwK2RlcFNFKSx3aWR0aD0uMDUsZmlsbD0iYmx1ZSIsYWxwaGE9LjUpICsKICB0aGVtZV9idygpICsgeWxhYigiZGVwdGggT1IgbnVtYmVyIG9mIHN0YXRpb25zIHJlcG9ydGluZyIpCmBgYApJbmhlcml0YW5jZToKYGBge3J9CmdncGxvdChkYXRhPXF1YWtlcywgYWVzKHg9bG9uZykpICsKICBnZW9tX3BvaW50KGFlcyh5PWxhdCxjb2xvdXI9c3RhdGlvbnMpKSAjKwogICNnZW9tX3BhdGgoKQpgYGAKCgojIyBTdG9yeXRlbGxpbmcgd2l0aCBkYXRhIHsudGFic2V0fQoKPiBTZWUgKipTaW11bGF0ZWQgRGF0YSoqIG5vdGVib29rCgpgYGB7cn0KZGF0YSA8LSByZWFkX2NzdigiLi4vZGF0YS9zaW11bGF0ZWQtZGF0YS5jc3YiKQpgYGAKCgojIyMgVGhlIFRlbiBDb21tYW5kbWVudHMgb2YgU3RhdGlzdGljYWwgSW5mZXJlbmNlCgohW10oLi4vaW1hZ2VzLzEwc3RhdHMuanBnKQoKIyMjIEV4cGxvcmF0aW9uCgpQbG90IGJveHBsb3RzIGFuZCB2aW9saW4gcGxvdHMgZm9yIHRoZSByYXRpbmdzLiBTdWJzZXQgYnkgcGFydGljaXBhbnQuCmBgYHtyfQpkYXRhICU+JQogIGZpbHRlcihyZWdpb24gPT0gMSkgJT4lCiAgZ2dwbG90KGFlcyh4PWdyYW0sIHk9cmF0aW5nLCBmaWxsPWZyZXEpKSArCiAgZ2VvbV9ib3hwbG90KHBvc2l0aW9uID0gcG9zaXRpb25fZG9kZ2UoLjkpKSArCiAgI2dlb21fdmlvbGluKGFscGhhPS41KSArCiAgZmFjZXRfd3JhcCh+c3ViaikKYGBgCgpHcm91cCBieSByZWdpb24sIHdvcmQsIGZyZXF1ZW5jeSwgYW5kIGdyYW1tYXRpY2FsaXR5LiBTdW1tYXJpc2UgbWVhbiBhbmQgc3RhbmRhcmQgZXJyb3IuCmBgYHtyfQpkYXRhICU+JQogIGdyb3VwX2J5KHJlZ2lvbiwgd29yZCwgZnJlcSwgZ3JhbSkgJT4lCiAgc3VtbWFyaXNlKG1lYW5SVCA9IG1lYW4ocnQpLAogICAgICAgICAgICBzZVJUID0gc2QocnQpL3NxcnQobigpKSkgJT4lCiAgZ2dwbG90KGFlcyh4PXJlZ2lvbix5PW1lYW5SVCxjb2xvdXI9Z3JhbSkpICsKICAgIGdlb21fcG9pbnQoKSArCiAgICBnZW9tX3BhdGgoYWVzKGx0eT1mcmVxKSkgKwogICAgZ2VvbV9lcnJvcmJhcihhZXMoeW1pbj1tZWFuUlQtc2VSVCwgeW1heD1tZWFuUlQrc2VSVCksd2lkdGg9LjEpICsKICBzY2FsZV94X2NvbnRpbnVvdXMoYnJlYWtzPWMoMTo1KSxsYWJlbHMgPSBjKCJ0aGUiLCJvbGQiLCJWRVJCIiwidGhlIiwiYm9hdCIpKSArCiAgeWxhYigicmVhZGluZyB0aW1lIChtaWxpc2Vjb25kcykiKQpgYGAKCiMjIyMgV2h5PyAKCldlbGwsIGNoZWNrIG91dCB0aGUgW0RhdGFzYXVydXMgRG96ZW5dKGh0dHBzOi8vd3d3LmF1dG9kZXNrcmVzZWFyY2guY29tL3B1YmxpY2F0aW9ucy9zYW1lc3RhdHMpLCB3aGljaCBhbGwgaGF2ZSB0aGUgc2FtZSB4L3kgbWVhbnMgYW5kIHN0YW5kYXJkIGRldmlhdGlvbnM6CiFbXSguLi9pbWFnZXMvZGF0YXNhdXJ1cy5naWYpCgojIyMgQ29udGludW91cyBkYXRhCgpgYGB7cn0KbGlicmFyeShsbWU0KQpgYGAKCkJ1aWxkIGEgc2ltcGxlIGxpbmVhciBtb2RlbCB0byBleGFtaW5lIHJlZ2lvbiAzICh0aGUgdmVyYik6CmBgYHtyfQojIHN1bW1hcnkoCiMgICAgIGxtICggRFYgfiBJVjEgKiBJVjIgKyBJVjMgLCBkYXRhID0gZGF0YSApCiMgICAgICAgICkKc3VtbWFyeShsbShydCB+IGZyZXEgKiBncmFtICsgYWdlLCBkYXRhW2RhdGEkcmVnaW9uPT0zLF0pKQpgYGAKCkFkZCBpbiBtaXhlZCBlZmZlY3RzIGZvciBhIGxpbmVhciBtaXhlZCBlZmZlY3RzIG1vZGVsOgpgYGB7cn0KI3N1bW1hcnkoCiMgIGxtZXIoIERWIH4gSVYxICogSVYyICsgSVYzICsgKCAxIHwgUlYxICkgKyAoIDEgfCBSVjIgKSAsIGRhdGEgPSBkYXRhKQojICAgICAgICApCnN1bW1hcnkobG1lcihydCB+IGZyZXErZ3JhbStmcmVxOmdyYW0rYWdlICsgKDF8c3ViaikgKyAoMXxpdGVtKSxkYXRhICU+JSBmaWx0ZXIocmVnaW9uPT0zKSkpCmBgYAoKIVtdKC4uL2ltYWdlcy9sbWVyLmpwZykKPHNtYWxsPkJvZG8gV2ludGVyIHRlbGxpbmcgaXQgbGlrZSBpdCBpcy4gKFBob3RvIGNyZWRpdDogQWRhbSBTY2hlbWJyaSAyNy8wMi8yMDE5KTwvc21hbGw+CgpXZSBzaG91bGQgZG8gbW9kZWwgY29tcGFyaXNvbiB0byBhc3Nlc3MgdGhlIGNvbnRyaWJ1dGlvbiBvZiBlYWNoIG9mIHRoZSBmYWN0b3JzIHRvIHRoZSBvdmVyYWxsIGZpdC4gQnV0LCByZWFkIHRoZSBCYXRlcyBldCBhbCBhbmQgQmFyciBldCBhbCBwYXBlcnMgZm9yIGFuIG92ZXJ2aWV3IG9mIHRoZSBkZWJhdGVzIGFyb3VuZCBob3cgdG8gZGVzaWduIGFuZCB0ZXN0IG1vZGVscy4KCkxldCdzIGRvIG1vZGVsIGNvbXBhcmlzb24gZm9yIHJlZ2lvbiAzOgpgYGB7cn0KbWRsMS5tYXggPC0gbG1lcihydCB+IGZyZXEqZ3JhbSArIGFnZSArIGFjY3VyYWN5ICsgKDF8c3ViaiksZGF0YVtkYXRhJHJlZ2lvbj09MyxdKQptZGwxLmFnZSA8LSBsbWVyKHJ0IH4gZnJlcSpncmFtICsgYWNjdXJhY3kgKyAoMXxzdWJqKSxkYXRhW2RhdGEkcmVnaW9uPT0zLF0pCm1kbDEuYWNjIDwtIGxtZXIocnQgfiBmcmVxKmdyYW0gKyBhZ2UgKyAgKDF8c3ViaiksZGF0YVtkYXRhJHJlZ2lvbj09MyxdKQptZGwxLmludCA8LSBsbWVyKHJ0IH4gZnJlcStncmFtICsgYWdlICsgYWNjdXJhY3kgKyAoMXxzdWJqKSxkYXRhW2RhdGEkcmVnaW9uPT0zLF0pCm1kbDEuZnJxIDwtIGxtZXIocnQgfiBncmFtICsgYWdlICsgYWNjdXJhY3kgKyAoMXxzdWJqKSxkYXRhW2RhdGEkcmVnaW9uPT0zLF0pCm1kbDEuZ3JtIDwtIGxtZXIocnQgfiBmcmVxICsgYWdlICsgYWNjdXJhY3kgKyAoMXxzdWJqKSxkYXRhW2RhdGEkcmVnaW9uPT0zLF0pCgphbm92YShtZGwxLm1heCxtZGwxLmFnZSkgIyBtYXggdnMgYWdlCmFub3ZhKG1kbDEubWF4LG1kbDEuYWNjKSAjIG1heCB2cyBhY2MKYW5vdmEobWRsMS5tYXgsbWRsMS5pbnQpICMgbWF4IHZzIGludAphbm92YShtZGwxLmludCxtZGwxLmZycSkgIyBpbnQgdnMgZnJxCmFub3ZhKG1kbDEuaW50LG1kbDEuZ3JtKSAjIGludCB2cyBncm0KCmBgYAoKSG93IGRvIHJlZ2lvbnMgNCBhbmQgNSBjb21wYXJlPzoKYGBge3J9CgpgYGAKCiMjIyBPcmRpbmFsIGRhdGEKCkZpcnN0LCBob3cgY291bGQgd2UgZ28gYWJvdXQgdXNpbmcgYGxtZXJgIGZvciByYXRpbmcgZGF0YT8KYGBge3J9Cm1kbC5vcmQgPC0gbG1lcihyYXRpbmcgfiBmcmVxKmdyYW0gKyAoMXxzdWJqKSwgZGF0YSU+JWZpbHRlcihyZWdpb249PTEpKQpzdW1tYXJ5KG1kbC5vcmQpCmBgYAoKIyMjIyBCZXR0ZXIgb3JkaW5hbCBkYXRhCgpgYGB7cn0KbGlicmFyeShvcmRpbmFsKQpgYGAKCkZvciB0aGUgcmF0aW5ncywgYnVpbGQgbW9kZWxzIGxpa2UgYWJvdmUsIGJ1dCB1c2luZyBgY2xtbSgpYCAodGhlc2UgdGFrZSBhIGxpdHRsZSBsb25nZXIgdG8gcnVuKToKYGBge3J9Cm1kbC5vcmQuY2xtbSA8LSBjbG1tKGFzLmZhY3RvcihyYXRpbmcpIH4gZnJlcSpncmFtICsgYWdlICsgKDF8c3ViaiksIGRhdGElPiVmaWx0ZXIocmVnaW9uPT0xKSkKc3VtbWFyeShtZGwub3JkLmNsbW0pCmBgYAoKPiBTZWUgKip2aXN1YWxpc2luZ19vcmRpbmFsX2RhdGEuUioqIGZvciBQcmVkaWN0ZWQgQ3VydmVzIHNjcmlwdAoKIyMjIEJpbm9taWFsIGRhdGEKCmBgYHtyfQpkYXRhICU+JQogIGZpbHRlcihyZWdpb249PTEpICU+JQogIG11dGF0ZShhZ2VfZ3JvdXAgPSBjYXNlX3doZW4oYWdlPDM1fiJ5b3VuZyIsCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICBhZ2U+PTM1JmFnZTw9NTV+Im1pZGRsZSIsCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICBhZ2U+NTV+Im9sZCIpKSAlPiUKICBtdXRhdGUoYWdlX2dyb3VwID0gZmFjdG9yKGFnZV9ncm91cCxsZXZlbHM9YygieW91bmciLCJtaWRkbGUiLCJvbGQiKSkpJT4lCiAgZ3JvdXBfYnkoZnJlcSxncmFtLGFnZV9ncm91cCkgJT4lCiAgc3VtbWFyaXNlKGFjY3VyYWN5PXN1bShhY2N1cmFjeSkvbigpKSAlPiUKICBnZ3Bsb3QoYWVzKHg9ZnJlcSxmaWxsPWdyYW0seT1hY2N1cmFjeSkpKwogIGdlb21fYmFyKHN0YXQ9ImlkZW50aXR5Iixwb3NpdGlvbj0iZG9kZ2UiKSsKICBmYWNldF93cmFwKH5hZ2VfZ3JvdXApCmBgYAoKCkRvZXMgYWNjdXJhY3kgY2hhbmdlIGFzIGEgZnVuY3Rpb24gb2YgYWdlPwpgYGB7cn0KIyBzdW1tYXJ5KAojICAgZ2xtZXIoIERWIH4gSVYxICogSVYyICsgSVYzICsgKCAxIHwgUlYxICkgKyAoIDEgfCBSVjIgKSwgZmFtaWx5PSJiaW5vbWlhbCIsIGRhdGEgPSBkYXRhKQojICkKYGBgCgpEbyBtb2RlbCBjb21wYXJpc29uIHRvIGFzc2VzcyB0aGUgY29udHJpYnV0aW9uIG9mIGVhY2ggb2YgdGhlIGZhY3RvcnMgdG8gdGhlIG92ZXJhbGwgZml0OgpgYGB7cn0KCmBgYAoK